perm filename WINDOW.FAI[XAP,BGB] blob
sn#052885 filedate 1973-07-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00016 PAGES
C00003 00002 Window & Area Commands:
C00004 00003 Data structure header:
C00005 00004 Fields declarations:
C00007 00005 Node format:
C00009 00006 Subroutines MKNODE,KLNODE
C00011 00007 NSUBR MORCOR Get more core for data structure
C00013 00008 Subroutines RINGIN,RINGOUT
C00015 00009 NSUBR INORDER,NODE,NUMBER,RING,FETCH
C00018 00010 Subroutines COPNOD,COPRING,KLRING
C00020 00011 Subroutines MKPAGE,KLSTATES
C00022 00012 NSUBR FNDAREA,PAGE,NAME Find area from name
C00023 00013 NSUBR SUBWINDOW,PAGE,WINDOW Subtract window
C00028 00014 NSUBR DOCINIT Setup default page
C00029 00015 Subroutines NXTPAGE,NXTWINDOW,SETWINDOW,SETMARGINS
C00031 00016 XAREA: Select an area.
C00033 00017 XWINDOW: Windowing commands
C00037 00018 XTMPLT: Apply next command to template
C00039 00019 END SA
C00040 ENDMK
C⊗;
;Window & Area Commands:
COMMENT ⊗
If these are prefixed with '∀', refers to template, otherwise current page.
A<area name>; Select area. Select named area.
WM<col0><coln><row0><rown>; WINDOW MAKE. Flushes any current windows in current
area and make a new window.
WA<col0><coln><row0><rown>; WINDOW ADD. Add a window to current area, subtracting
it from existion windows.
WO<col0><coln><row0><rown>; WINDOW OVERLAY. Add a window to current area, overlaying
existing windows.
WS<col0><coln><row0><rown>; WINDOW SUBTRACT. Subtract a window to from all areas.
⊗;
;Data structure header:
INTERN DOCUMENT,BLKCNT,AVAIL,REMAINDER,PAGE,AREA
NODSIZ←←4
OLDFF: 0
DOCUMENT: 0
BLKCNT: 0
AVAIL: 0
TMPLT: 0
REMAINDER:0
PAGE: 0
AREA: 0
WINDOW: 0
ANAME: 0
DFANAM: SIXBIT/TEXT/
;Fields declarations:
;Macros to make them
DEFINE LFIELD $(NAME,OFFSET,TYPE)
{IFIDN <TYPE><>
<DEFINE NAME(AC,NODE)
{ HLRZ AC,OFFSET(NODE)
}
DEFINE NAME$.(AC,NODE)
{ HRLM AC,OFFSET(NODE)
}>
IFIDN <TYPE><I>
<DEFINE NAME(AC,NODE)
{ HLRE AC,OFFSET(NODE)
}
DEFINE NAME$.(AC,NODE)
{ HRLM AC,OFFSET(NODE)
}>
IFIDN <TYPE><F>
<DEFINE NAME(AC,NODE)
{ HLLE AC,OFFSET(NODE)
}
DEFINE NAME$.(AC,NODE)
{ HLLM AC,OFFSET(NODE)
}>}
DEFINE RFIELD $(NAME,OFFSET,TYPE)
{IFIDN <TYPE><>
<DEFINE NAME(AC,NODE)
{ HRRZ AC,OFFSET(NODE)
}
DEFINE NAME$.(AC,NODE)
{ HRRM AC,OFFSET(NODE)
}>
IFIDN <TYPE><I>
<DEFINE NAME(AC,NODE)
{ HRRE AC,OFFSET(NODE)
}
DEFINE NAME$.(AC,NODE)
{ HRRM AC,OFFSET(NODE)
}>
IFIDN <TYPE><F>
<DEFINE NAME(AC,NODE)
{ HRLE AC,OFFSET(NODE)
}
DEFINE NAME$.(AC,NODE)
{ HLRM AC,OFFSET(NODE)
}>}
;____________________________________________________________________
LFIELD(CW,0)↔ RFIELD(CCW,0)
LFIELD(DAD,1)↔ RFIELD(SON,1)
LFIELD(CMIN,2,I)↔ RFIELD(CMAX,2,I)
LFIELD(RMIN,3,I)↔ RFIELD(RMAX,3,I)
RFIELD(PAGNO,3,I)
LFIELD(PTYPE,3)
LFIELD(ATYPE,3) RFIELD(STATE,3)
↓$COL←←2
↓$ROW←←3
↓$PNAME←←2
;Node format:
COMMENT $
1. Document
---------------------
0 | --- AVAIL | Pointer to free list
1 | --- SON | SON(DOCUMENT)=PAGE
2 | --- Blkcnt | Total number of block in use
3 | --- TMPLT | PAGE template ring
---------------------
2. Page Node
---------------------
0 | CW CCW | Previous and next pages.
1 | DAD SON | DAD(PAGE)=DOCUMENT, SON(PAGE)=AREA
2 | Pagno |
3 | Ptype | Page type bits
---------------------
3. Area
---------------------
0 | CW CCW | Previous and next areas
1 | DAD SON | DAD(AREA)=PAGE, SON(AREA)=WINDOW
2 | Pname |
3 | Atype STATE | Area type bits, Pointer to position in area.
---------------------
4. Window
---------------------
0 | CW CCW | Previous and next windows
1 | DAD --- | DAD(WINDOW)=PAGE
2 | cmin cmax | Min and max columns
3 | rmin rmax | Min and max rows
---------------------
5. State
---------------------
0 | --- --- |
1 | --- SON | Pointer to window
2 | --- cmax | Column position
3 | --- rmax | Row position
---------------------
0. Empty
---------------------
0 | -1 AVAIL | Next free node
1 | |
2 | |
3 | |
---------------------
$;
;Subroutines MKNODE,KLNODE
;____________________________________________________________________
NSUBR(MKNODE)
; ALLOCATE A NODSIZ BLOCK OF WORDS - BGB - 4 DEC 1972.
SKIPN 1,@AVAIL
CALL(MORCOR)
HRRZ(1)↔HRRM @AVAIL
SETZM(1)↔AOS @BLKCNT
POP0J
SUBREND MKNODE
;____________________________________________________________________
NSUBR(KLNODE,NODE)
; RELEASE A NODSIZ BLOCK OF WORDS - BGB - 4 DEC 1972.
MOVE 1,NODE
SKIPGE (1)↔GO [ FATAL<EMPTY NODE KILLED!>]
SOS @BLKCNT
SETZM(1)↔HRLI(1)↔HRRI 1(1)↔BLT NODSIZ-1(1)
MOVE @AVAIL↔HRROM(1)↔HRRZM 1,@AVAIL
; POP1J
SUB P,[XWD 2,2]↔JRST @2(P);Faster
SUBREND KLNODE
NSUBR MORCOR ;Get more core for data structure
;INITIALIZE DOCUMENT BLOCK POINTERS WHEN NECESSARY.
; SKIPE OLDFF↔GO L1
SKIPE OLDFF↔GO [ FATAL(NODE SPACE FULL) ]
MOVE 1,JOBFF↔MOVEM 1,OLDFF
; AOS 1↔MOVEM 1,DOCUMENT
; ADDI 1,3↔MOVEM 1,AVAIL
; AOS 1↔MOVEM 1,BLKCNT
MOVEM 1,DOCUMENT
MOVEM 1,AVAIL
ADDI 1,2↔MOVEM 1,BLKCNT
AOS 1↔MOVEM 1,TMPLT
SETZM REMAINDER
;FOUR MORE K !
L1: MOVE 1,JOBFF↔MOVE 0,1↔ADDI 0,10000
HRRE 0,0↔JUMPL 0,[FATAL(127K MAX FOR XAP, YOU LOSE)]
CALLI 11↔GO[FATAL(NO MORE CORE.)]
AOS 1↔SUB 1,REMAINDER↔MOVEM 2,AC2#↔MOVE 2,JOBFF
ADDI 2,10000↔MOVEM 2,JOBFF
SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
;MAKE AVAIL LIST.
HRLM 1,1↔ADD 1,[XWD NODSIZ,0]
SKIPE @BLKCNT↔GO .+3
ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@BLKCNT
DAPZ 1,@AVAIL
L2: HLROM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
HRROS (1);MARK LAST ONE!
SUBI 2,NODSIZ-1(1)↔MOVEM 2,REMAINDER
; MOVEI 10000↔ADDM @DOCUMENT
; MOVE 1,DOCUMENT↔MOVE[FILBIT+010000]↔MOVEM 2(1)
MOVE 1,@AVAIL
MOVE 2,AC2↔POP0J
SUBREND;12/16/72-----------------------------------------------------
;Subroutines RINGIN,RINGOUT
;____________________________________________________________________
NSUBR RINGIN,PART,WHOLE
;RING PART INTO A WHOLE -BGB- 6 DEC 1972.
;Uses AC 1-3, returns PART in AC 1.
MOVE 1,PART
MOVE 3,WHOLE
DAD. 3,1
SON 2,3
JUMPE 2,[SON. 1,3↔CW. 1,1↔CCW. 1,1↔POP2J]
CW 3,2
CW. 3,1↔CCW. 1,3
CCW. 2,1↔CW. 1,2
POP2J
SUBREND RINGIN
;____________________________________________________________________
NSUBR RINGOUT,NODE
;Remove node from ring. -TVR- 9 JUN 1973
;Uses AC 1-3, returns CCW(NODE) in AC 1.
HRRZ 2,NODE ;Get node
CCW 1,2 ;Get next into 1
CAMN 1,2 ;Ring of one?
GO [ DAD 3,2 ;Yes, flush ring!
SETZ 1,
SON. 1,3
POP1J ] ;Return 0
CW 3,2 ;Previous into 3
CCW. 3,1 ;Make previous's next point to node's next
CCW. 1,3 ;Make next's previous point to node's previous
DAD 3,2 ;Is node the head of ring?
SON 1,3
CAMN 1,2
SON. 1,3 ;Yes, new head of ring
POP1J
SUBREND RINGOUT
NSUBR INORDER,NODE,NUMBER,RING,FETCH
;Insert node into ring in order
;Uses AC 0-3
NEW←3
LAC NEW,NODE ;Get node
LAC 2,RING ;And pointer to ring
DAD. 2,NEW ;Make it DAD of new node
SON 1,2 ;Does he have a son?
JUMPE 1,NEWRING
LOOP: XCT FETCH ;Fetch value
CAML 0,NUMBER ;Does value of this node come after new node?
GO FOUND ;Yes, then we have found it
CCW 1,1 ;No, get next node
CAME 1,RING ;Have we reached the end?
GO LOOP ;No, try again
ADDNOD: CW 2,1 ;Insert new node before this node
CW. 2,NEW↔CW. NEW,1 ;Clockwise pointers
CCW. 1,NEW↔CCW. 3,NEW ;CounterClockwise pointers
POP4J
FOUND: SON 0,2 ;Get back head of ring
CAMN 0,2 ;Before head of ring?
SON. NEW,2 ;Yes, new ring leader!
GO ADDNOD ;Make the rest of the links
NEWRING:SON. NEW,2 ;Make new ring
CW. NEW,(NEW)↔CCW. NEW,(NEW) ;A ring of one
POP4J
SUBREND INORDER
;Subroutines COPNOD,COPRING,KLRING
;____________________________________________________________________
NSUBR COPNOD,NODE
;Copy node and subrings
ACCUMULATORS{N}
HRRZ N,NODE
CALL MKNODE
LAC 0,2(N)
DAC 0,2(1)
LAC 0,3(N)
DAC 0,3(1)
SON 0,N
JUMPE 0,POP1J.
CALL COPRING,0,1
LAC 1,2(P)
POP1J
SUBREND COPNOD
;____________________________________________________________________
NSUBR COPRING,OLDSON,NEWDAD
ACCUMULATORS{N}
HRRZ N,OLDSON
LOOP: CALL COPNOD,N
PUSHP 1(P)
CALL RINGIN,1,NEWDAD
POPP N
CCW N,N
CAME N,OLDSON
GO LOOP
POP2J
SUBREND COPRING
;____________________________________________________________________
NSUBR KLRING,NODE
;Delete NODE and any nodes contained in subrings of NODE.
;Return CCW(NODE)
;Uses AC 0-2
ACCUMULATOR{N}
LAC N,NODE ;Fetch node
SON 1,N
JUMPE 1,L2
L1: CALL KLRING,1 ;Kill first node in ring
JUMPN 1,L1
LAC N,NODE
L2: CCW 0,N ;Next in ring
CAMN 0,N ;End of ring [containing NODE]?
GO [ SETZ 0, ;Yes, clear SON pointer of DAD
DAD 1,N
SON. 0,1
GO .+1 ]
PUSHP 0 ;Save CCW(NODE)
CALL KLNODE,N
POPP 1
POP1J
SUBREND KLRING
;Subroutines MKPAGE,KLSTATES
;____________________________________________________________________
NSUBR MKPAGE,NUMBER,TEMPLATE
CALL MKNODE ;Make a page
DAC 1,NEWPAG ;Save it somewhere
LAC 0,NUMBER ;Set page number
PAGNO. 0,1
CALL(INORDER,1,NUMBER,DOCUMENT,<[PAGNO 0,1]>) ;Insert into doc.
LAC 1,TEMPLATE ;Pick up template
SON 1,1 ;Pick up area ring
JUMPE 1,L2 ;If none, return
CALL COPRING,1,NEWPAG ;Copy area ring into page
LAC 0,1
LAC 1,NEWPAG
SON. 0,1
CALL(KLSTATES,NEWPAG) ;Flush any state nodes
L2: LAC 1,NEWPAG ;Return page in AC 1.
POP2J
DECLARE{NEWPAG}
SUBREND MKPAGE
;____________________________________________________________________
NSUBR KLSTATES,PAGE
;Kill any state nodes on this page.
LAC 1,PAGE ;Fetch page
SON 1,1 ;Fetch first area
JUMPE 1,POP1J. ;If none, return quickly
DAC 1,A0 ;Save first for end check
L1: STATE 0,1 ;Pick up state
JUMPE 0,L2 ;Not used in this area.
PUSHP 1 ;Save area on stack
CALL KLNODE,0 ;Kill state node
POPP 1 ;Recouver area
SETZ 0, ;Clear state link
STATE. 0,1
L2: CCW 1,1 ;Fetch next area
CAME 1,A0 ;End of ring?
GO L1 ;No, do next area
POP1J ;Yes, return
DECLARE{A0}
SUBREND KLSTATES
NSUBR FNDAREA,PAGE,NAME ;Find area from name
ACCUMULATORS{A0}
A1←←1
SKIPN A1,PAGE↔POP2J ;Make sure there is a page.
SON A0,A1 ;Fetch first area
JUMPE A0,POP2J. ;...if any
LAC A1,A0
LAC 0,NAME ;Fetch name to search for
JUMPN 0,LOOP ;If none, assume default
LAC 0,DFANAM ;area name
LOOP: CAMN 0,$PNAME(A1) ;Pick up name of this area
POP2J ;If equal, return named area
CCW A1,A1 ;Not equal, fetch next area
CAME A1,A0 ;End of ring?
JUMPN A1,LOOP ;No, go to loop
SETZ A1, ;Yes, area not found, return NIL
POP2J
SUBREND FNDAREA
NSUBR SUBWINDOW,PAGE,WINDOW ;Subtract window
ACCUMULATORS{OR1,OR2,OC1,OC2,NR1,NR2,NC1,NC2,NEW,A1,W0,W1,W2} ;ALL EXCEPT 17
HRRZ NEW,WINDOW
RMIN NR1,NEW ;Fetch limits of window
RMAX NR2,NEW
CMIN NC1,NEW
CMAX NC2,NEW
SKIPN 1,PAGE ;Make sure there's a window here.
GO [ FATAL<No page at SUBWINDOW!> ]
SON A1,1
DAC A1,A0
JUMPE A1,POP2J. ;No areas, quick exit!
ALOOP: SON W0,A1 ;For each area.
SKIPN W1,W0 ;If there is one...
GO ADONE
WLOOP: CAMN W1,WINDOW ;Don't delete yourself!
GO WDONE
RMIN OR1,W1 ;For each window
RMAX OR2,W1
CAMGE OR1,NR2 ;Is rows of new window within rows of old?
CAMG OR2,NR1
GO WDONE ;No, this window OK.
CMIN OC1,W1
CMAX OC2,W1
CAMGE OC1,NC2 ;Are columns of new window within columns of old?
CAMG OC2,NC1
GO WDONE ;No, this window OK.
SETZM USED ;Clear flag indicated node has been used.
CAMG NR1,OR1 ;Does new window extend above old window?
GO NOTABV ;Yes, part old window is not above new window
; CALL AFTER ;(We don't need to make a window as old one not used.)
RMAX. NR1,W1 ;Change make beginning of new window be end of old.
SETOM USED ;We have used old window.
NOTABV: CAMG NC1,OC1 ;Is there anything to the left of new window?
GO NOTLFT ;No, not left of window
CALL MIDDLE ;Set rows
CMIN. OC1,W1 ;Set columns
CMAX. NC1,W1
NOTLFT: CAMG NC1,OC1 ;Is there anything to the right of new window?
GO NOTRGT ;No, not right of window
CALL MIDDLE ;Set rows
CMIN. NC2,W1 ;Set columns
CMAX. OC2,W1
NOTRGT: CAML NR2,OR2 ;Is there anything below new window?
GO NOTBLW ;No, not below.
CALL AFTER ;Get a window after old window.
RMIN. NR2,W1 ;Set rows.
RMAX. OR2,W1
CMIN. OC1,W1 ;Set columns.
CMAX. OC2,W1
NOTBLW: SKIPE USED ;Was old window used?
GO WDONE ;YES
CALL RINGOUT,W1 ;Consider it empty
CAMN W1,W0
DAC 1,W0
PUSHP 1
CALL KLNODE,W1
POPP W1
SKIPA
WDONE: CCW W1,W1 ;Window done, get next
CAME W1,W0 ;At end?
JUMPN W1,WLOOP ;No, do next window
ADONE: CCW A1,A1 ;Area done
CAME A1,A0 ;At end of area ring?
GO ALOOP ;No, do next area
LAC 1,WINDOW ;Return window if anyone cares.
POP2J
;Insert window after old window if old window has already been used.
AFTER: SKIPN USED ;Has old window been used?
GO [ SETOM USED ;No, use it then
POP0J ]
CCW W2,W1 ;Already in use, make a new window.
CALL MKNODE
CCW. W2,1
CCW. 1,W1
CW. W1,1
CW. 1,W2
DAD. A1,1
LAC W1,1
POP0J
;Make window to left or right of new window.
MIDDLE: CALL AFTER ;Get a window after old window.
RMIN. NR1,W1 ;Set top of window.
RMAX. NR2,W1 ;Set bottom of window.
CAMLE NR2,OR2 ;Did we use the lower one?
RMAX. OR2,W1 ;Oops, use other one.
POP0J ;Return
DECLARE{A0,USED}
SUBREND SUBWINDOW
NSUBR DOCINIT ;Setup default page
CALL(MORCOR)
CALL(COPNOD,[TMPLT0])
LAC 0,DOCUMENT
CCW. 1,1
CW. 1,1
DAD. 0,1
DAC 1,@TMPLT
POP0J
TMPLT0: XWD .,. ;PAGE
XWD 0,AREA1
0
0
AREA1: XWD AREA2,AREA2 ;TITLE AREA
XWD TMPLT0,W1
SIXBIT/TITLE/
0
AREA2: XWD AREA1,AREA1 ;TEXT AREA
XWD TMPLT0,W2
SIXBIT/TEXT/
0
W1: XWD .,.
XWD AREA1,0
XWD =200,=1500
XWD =100,=150
W2: XWD .,.
XWD AREA2,0
XWD =200,=1500
XWD =200,=2000
SUBREND DOCINIT
;Subroutines NXTPAGE,NXTWINDOW,SETWINDOW,SETMARGINS
;____________________________________________________________________
NSUBR NXTPAGE
CALL(MKPAGE,[0],@TMPLT) ;Make a new page
DAC 1,PAGE ;Save for other subrs.
LAC 1,@TMPLT ;Advance templates
CCW 1,1
DAC 1,@TMPLT
CALL FNDAREA,PAGE,ANAME ;Find area for other subrs.
DAC 1,AREA ;Save it
JUMPE 1,CPOPJ ;If none, return
SON 1,1 ;Pick up first window
JUMPN 1,SETWIN ;Unless it's null, set margins and position
CPOPJ: POP0J ;Return
SUBREND NXTPAGE
;____________________________________________________________________
NSUBR NXTWINDOW ;Advance to next window
LAC 1,AREA ;Fetch area
SON 0,1 ;Fetch first area
LAC 1,WINDOW ;Pick up current window
CCW 1,1 ;Fetch next window
CAMN 1,0 ;Same as first
GO [ FATAL<AREA FULL> ] ;Yes, lose big [ should advance to next page ]
;NSUBR SETWINDOW
↑SETWIN:DAC 1,WINDOW
CMIN 0,1
DAC 0,COL
RMIN 0,1
DAC 0,ROW
;NSUBR SETMARGINS
↑SETMAR:LACN 0,LMAR
ADDM 0,TJLMAR
ADDM 0,COL
CMIN 0,1
DAC 0,LMAR
ADDM 0,TJLMAR
ADDM 0,COL
LACN 0,RMAR
ADDM 0,TJRMAR
CMAX 0,1
DAC 0,RMAR
RMAX 0,1
DAC 0,ROWMAX
ADDM 0,TJRMAR
POP0J
SUBREND NXTWINDOW
XAREA: ;Select an area.
BEGIN XAREA
; CALL(RDSIX,[CALL(GETCHR)])
LAC 2,[POINT 6,ANAME]
SETZM ANAME
LOOP: CALL(GETCHR)
CAIL 1,"a"
CAILE 1,"z"
SKIPA
SUBI 1,"a"-"A"
CAILE 1," "
CAILE 1,"Z"
GO FIN
CAIN 1,";"
GO FIN
SUBI 1,40
CAME 2,[POINT 6,ANAME,35]
IDPB 1,2
GO LOOP
FIN: CALL FNDAREA,PAGE,ANAME
EXCH 1,AREA
LAC 2,1
STATE 1,2
JUMPN 1,SAVSTA
CALL MKNODE
STATE. 1,2
SAVSTA: LAC 0,WINDOW↔SON. 0,1 ;REMEMBER WHERE WE LEFT OFF
LAC 0,COL↔CMAX. 0,1
LAC 0,ROW↔RMAX. 0,1
LAC 2,AREA
STATE 1,2
JUMPN 1,[ CMAX 0,1↔DAC 0,COL ;GET BACK OLD STATE
RMAX 0,1↔DAC 0,ROW
SON 1,1↔GO SETMAR ]
SON 1,2 ;PICK UP FIRST WINDOW
GO SETWINDOW
BEND XAREA
XWINDOW: ;Windowing commands
BEGIN XWINDOW
COMMENT ⊗
WM<col0><coln><row0><rown>; WINDOW MAKE
WA<col0><coln><row0><rown>; WINDOW ADD
WO<col0><coln><row0><rown>; WINDOW OVERLAY
WS<col0><coln><row0><rown>; WINDOW SUBTRACT
⊗;
ACCUMULATORS{T1,T2,A1,COL0,COLN,ROW0,ROWN,W1}
;Read window limits.
CALL GETCHR
SKIPN BUGFLG
GO L1
OUTSTR[ASCIZ/Window-/]
OUTCHR 1
OUTSTR[ASCIZ/
/]
L1: CAIN 1,"M"
GO [ CALL RINGOUT,AREA↔CALL KLRING,AREA
SETZM AREA↔SETZM WINDOW
SETOM SUBFLG↔SETOM AFLAG↔GO RDSET ]
CAIN 1,"A"
GO [ SETOM SUBFLG↔SETOM AFLAG↔GO RDSET ]
CAIN 1,"O"
GO [ SETZM SUBFLG↔SETOM AFLAG↔GO RDSET ]
CAIN 1,"S"
GO [ SETOM SUBFLG↔SETZM AFLAG↔GO RDSET ]
FATAL(UNKNOWN 'W' COMMAND.)
RDSET: LACI T1,COL0
RDLOOP: CALL GETNUM
DAC 1,(T1)
CAIN T1,ROWN
GO RDFIN
CAIE 0,","
OUTSTR[ASCIZ/WARNING: MISSING COMMA IN WINDOW SPEC.
/]↔ AOJA T1,RDLOOP
RDFIN: CAIE 0,";"
GO [ OUTSTR[ASCIZ/WARNING: MISSING SEMICOLON OR EXTRA NUMBER IN WINDOW SPEC.
/]↔ CALL GETCHR
SKIPE EOF
GO [ FATAL<EOF in window spec.> ]
CAIE 0,";"
GO $.-4
GO .+1 ]
;Check for errors:
SKIPN PAGE
GO [ FATAL<Attempt to create window in non-existant page!> ]
SKIPL ROW0
SKIPGE COL0
GO [ FATAL<Negative window limit!> ]
CAIG ROW0,MROWS
CAILE COL0,NCOLS
GO [ FATAL<Window limit too big> ]
CAMGE ROW0,ROWN
CAML COL0,COLN
GO [ FATAL<Minimum≥Maximum in window limits> ]
;Make an area, if none or if 'WS'
SKIPE AFLAG ;Need an area?
SKIPE A1,AREA
GO GOTAREA ;No
CALL MKNODE ;Yes, make one
LAC A1,1
DAC A1,AREA
LAC 0,ANAME ;Set name
DAC 0,$PNAME(A1)
CALL RINGIN,A1,PAGE ;Into page ring
;Make a window
GOTAREA:CALL(MKNODE)
LAC W1,1
RMIN. ROW0,W1 ;Set parameters
RMAX. ROWN,W1
CMIN. COL0,W1
CMAX. COLN,W1
SKIPN AFLAG ;Is it added to area?
GO GOTWIN ;No
CALL RINGIN,W1,A1
;Subtract window from any existing windows.
GOTWIN: SKIPN SUBFLG ;Is it subtracted from page
GO DONE ;No, we're done
CALL SUBWINDOW,PAGE,W1
LAC W1,2(P) ;Recover W1 from stack
SKIPE AFLAG ;Is it added to area
GO DONE ;No, just return
CALL KLNODE,W1 ;Yes, kill window just subtracted to recover space
;Check to see if current window was flushed
DONE: SKIPN 1,WINDOW
GO [ LAC 1,W1
DAC 1,WINDOW
GO SETWINDOW ]
JUMPG 1,SETMARGIN
FATAL<Current window disappeared!>
DECLARE{AFLAG,SUBFLG}
BEND XWINDOW
XTMPLT: ;Apply next command to template
BEGIN XTMPLT
PUSH P,PAGE ;Save current page
LAC @TMPLT ;Make template current page
DAC PAGE
CALL FNDAREA,PAGE,ANAME ;Change area pointer
CALL GETCHR ;Now, which command
CAIN 1,"W" ;Window commands
GO [ CALL XWINDOW ;Execute command
GO RET ]
FATAL(Illegal '∀' command.)
RET: POP P,PAGE
CALL FNDAREA,PAGE,ANAME
POP0J
BEND XTMPLT
END SA